COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	(RPAQQ PUZZL1COMS ((FNS * PUZZL1FNS)))
C00009 ENDMK
C⊗;
(RPAQQ PUZZL1COMS ((FNS * PUZZL1FNS)))


(RPAQQ PUZZL1FNS (START DEFINEPIECE TRIAL REMOVE PLACE FIT))


(* (SPECIAL SIZE CLASSMAX TYPEMAX D)
   (FIXNUM (PLACE FIXNUM FIXNUM) SIZE CLASSMAX TYPEMAX D))


(PROGN (SETQ TRUE T) (SETQ FALSE NIL))


(* (PROGN (SETQ TRUE T) (SETQ FALSE NIL)))


(SETQ SIZE 511)


(SETQ CLASSMAX 3)


(SETQ TYPEMAX 13)


(SETQ D 8)


(* (SPECIAL III KOUNT) (FIXNUM III I J K KOUNT M N))


(* (ARRAY* (FIXNUM PIECECOUNT 1 CLASS 1 PIECEMAX 1)
	   (NOTYPE PUZZLE 1 P 2)))


(DEFINE-ARRAY PIECECOUNT FIXNUM (IPLUS CLASSMAX 2))


(DEFINE-ARRAY CLASS FIXNUM (ADD1 TYPEMAX))


(DEFINE-ARRAY PIECEMAX FIXNUM (ADD1 TYPEMAX))


(DEFINE-ARRAY PUZZLE T (IPLUS SIZE 2))


(DEFINE-ARRAY P T (ADD1 TYPEMAX) (IPLUS SIZE 2))


(DEFINEQ
 (FIT (LAMBDA (I J) 
	((LAMBDA (END) 
	   (FOR
	    K
	    FROM
	    0
	    TO
	    END
	    DO
	    (COND ((*ELT P I (ADD1 K))
		   (COND ((ELT PUZZLE (IPLUS J K)) (RETURN NIL)))))
	    FINALLY
	    (RETURN T)))
	 (IDIFFERENCE (ELT PIECEMAX I) 1)))))


(DEFINEQ
 (PLACE
  (LAMBDA (I J) 
    ((LAMBDA (END) 
       (FOR K FROM 0 TO END DO
	    (COND ((*ELT P I (ADD1 K)) (SETA PUZZLE (IPLUS J K) T)))
	    FINALLY (RETURN NIL))
       (SETA PIECECOUNT
	     (ELT CLASS I)
	     (IDIFFERENCE (ELT PIECECOUNT (ELT CLASS I)) 1))
       (FOR K FROM J TO SIZE DO
	    (COND ((NOT (ELT PUZZLE K)) (RETURN K)))
	    FINALLY (RETURN 1)))
     (IDIFFERENCE (ELT PIECEMAX I) 1)))))


(DEFINEQ
 (REMOVE
  (LAMBDA (I J) 
    ((LAMBDA (END) 
       (FOR K FROM 0 TO END DO
	    (COND ((*ELT P I (ADD1 K)) (SETA PUZZLE (IPLUS J K) NIL)))
	    FINALLY (RETURN NIL))
       (SETA PIECECOUNT
	     (ELT CLASS I)
	     (IPLUS (ELT PIECECOUNT (ELT CLASS I)) 1)))
     (IDIFFERENCE (ELT PIECEMAX I) 1)))))


(DEFINEQ
 (TRIAL
  (LAMBDA (J) 
    ((LAMBDA (K) 
       (FOR I FROM 1 TO TYPEMAX DO
	    (COND ((NOT (IEQP (ELT PIECECOUNT (ELT CLASS I)) 0))
		   (COND ((FIT I J)
			  (SETQ K (PLACE I J))
			  (COND ((OR (TRIAL K) (IEQP K 1))
				 (SETQ KOUNT (IPLUS KOUNT 1))
				 (RETURN T))
				(T (REMOVE I J)))))))
	    FINALLY
	    (RETURN (PROGN (SETQ KOUNT (ADD1 KOUNT)) NIL))))
     1))))


(DEFINEQ
 (DEFINEPIECE
  (LAMBDA (ICLASS II JJ KK) 
    ((LAMBDA (INDEX) 
       (FOR I FROM 0 TO	II DO
	(FOR J FROM 0 TO JJ DO
	 (FOR K FROM 0 TO KK DO
	  (PROGN
	   (SETQ INDEX
		 (ADD1 (IPLUS I (ITIMES D (IPLUS J (ITIMES D K))))))
	   (*SETA P III INDEX T))
	  FINALLY
	  (RETURN NIL))
	 FINALLY
	 (RETURN NIL))
	FINALLY
	(RETURN NIL))
       (SETA CLASS III ICLASS)
       (SETA PIECEMAX III INDEX)
       (COND ((NOT (IEQP III TYPEMAX)) (SETQ III (IPLUS III 1)))))
     1))))


(DEFINEQ
 (START
  (LAMBDA NIL 
    (FOR M FROM 1 TO (ADD1 SIZE) DO (SETA PUZZLE M T)
	 FINALLY (RETURN NIL))
    (FOR I FROM 1 TO 5 DO
     (FOR J FROM 1 TO 5 DO
      (FOR K FROM 1 TO 5 DO
	   (SETA PUZZLE
		 (ADD1 (IPLUS I (ITIMES D (IPLUS J (ITIMES D K)))))
		 NIL)
	   FINALLY (RETURN NIL))
      FINALLY (RETURN NIL))
     FINALLY (RETURN NIL))
    (FOR I FROM 1 TO TYPEMAX DO
	 (FOR M FROM 1 TO (ADD1 SIZE) DO
	      (*SETA P I M NIL)
	      FINALLY (RETURN NIL))
	 FINALLY (RETURN NIL))
    (SETQ III 1)
    (DEFINEPIECE 1 3 1 0)
    (DEFINEPIECE 1 1 0 3)
    (DEFINEPIECE 1 0 3 1)
    (DEFINEPIECE 1 1 3 0)
    (DEFINEPIECE 1 3 0 1)
    (DEFINEPIECE 1 0 1 3)
    (DEFINEPIECE 2 2 0 0)
    (DEFINEPIECE 2 0 2 0)
    (DEFINEPIECE 2 0 0 2)
    (DEFINEPIECE 3 1 1 0)
    (DEFINEPIECE 3 1 0 1)
    (DEFINEPIECE 3 0 1 1)
    (DEFINEPIECE 4 1 1 1)
    (SETA PIECECOUNT 1 13)
    (SETA PIECECOUNT 2 3)
    (SETA PIECECOUNT 3 1)
    (SETA PIECECOUNT 4 1)
    ((LAMBDA (M N KOUNT) 
       (COND ((FIT 1 M) (SETQ N (PLACE 1 M)))
	     (T (TERPRI) (PRIN1 "Error")))
       (COND ((TRIAL N) (TERPRI)
			(PRIN1 "success in ")
			(PRIN1 KOUNT)
			(PRIN1 " trials"))
	     (T (TERPRI) (PRIN1 "failure")))
       (TERPRI))
     (IPLUS 2 (ITIMES D (IPLUS 1 D)))
     1
     0))))



STOP